dim doc
set doc = Application.ActiveDocument
dim unit,unit_str
gridx = doc.GridX	
doc.unit = 2'mil
unit_str = "mil"
Application.ModelessCmd("g0")
Application.ModelessCmd("gd0")
Application.StatusBarText = "Set Grids = 0"
if doc.LayerEnabled(65) then
	Application.ExecuteCommand("Display Colors Setup")
	DisplayColorsSetupDlg.ColorGrid.Cell("Layer_65", "#") = "1"
	DisplayColorsSetupDlg.ColorGrid.ClearSelection
	DisplayColorsSetupDlg.SelectedColor.SetActive (12)
	DisplayColorsSetupDlg.ColorGrid.Cell("Layer_65", "2D Lines") = "12"
	DisplayColorsSetupDlg.Ok.Click()
end if

dim ostr
dim tmpfile
tmpfile = doc.path & "\tmp1.mcr"
dim x1,x2,y1,y2
clyr = doc.activelayer
Application.ModelessCmd("l 65")
Application.ExecuteCommand("Any Angle Mode")
dim objs,obj
set objs = doc.GetObjects(ppcbObjectTypeLabel,, true) 
Dim fso,fw
Set fso = CreateObject("scripting.filesystemobject")
for each obj in objs
	x1 = obj.PositionX
	y1 = obj.PositionY
	x2 = obj.Component.PositionX
	y2 = obj.Component.PositionY
	
	'Drawing	
	ostr = "" & chr(13) & chr(10)
	ostr = ostr & "Application.HideBar(""Design Toolbar"")" & chr(13) & chr(10)
	ostr = ostr & "Application.ShowBar(""Drafting Toolbar"")" & chr(13) & chr(10)
	ostr = ostr & "Application.ExecuteCommand(""Add 2D Line Polyline"")" & chr(13) & chr(10)
	ostr = ostr & "Application.ExecuteCommand(""Drafting Path Mode"")" & chr(13) & chr(10)
	ostr = ostr & "Application.ExecuteCommand(""Add Corner To Drafting"", " & x1 & unit_str & ", " & y1 & unit_str & ") "& chr(13) & chr(10)
	ostr = ostr & "Application.ExecuteCommand(""Add Corner To Drafting"", " & x2 & unit_str & ", " & y2 & unit_str & ") "& chr(13) & chr(10)
	ostr = ostr & "Application.ExecuteCommand(""Complete Drafting"")" & chr(13) & chr(10)
	ostr = ostr & "Application.ExecuteCommand(""Cancel"")" & chr(13) & chr(10)
	ostr = ostr & "" & chr(13) & chr(10)
		
	Set fw = fso.CreateTextFile(tmpfile,True)
	fw.Write ostr
	fw.close				
	application.RunMacro(tmpfile,"")	
	Application.ExecuteCommand("Complete Drafting")
	Application.ExecuteCommand("Cancel")
next
Set fw = Nothing	
Set fso = Nothing
Application.ModelessCmd("l " & clyr)
Application.ModelessCmd("g " & gridx)
Application.ModelessCmd("gd " & gridx)
Application.StatusBarText = "Set Grids = " & gridx
	